Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH12/SRC/OBJPICT1.CLS

Text File | 1996-05-04 | 7.9 KB | 303 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjPicture"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Public Objects As New Collection

Const TYPE_STRING = "3D APF PICTURE"

' ************************************************
' Return the distance from the picture to a point.
' ************************************************
Property Get Distance(X As Single, Y As Single, z As Single) As Single
Dim best As Single
Dim dist As Single
Dim obj As Object

    best = INFINITY
    For Each obj In Objects
        dist = obj.Distance(X, Y, z)
        If best > dist Then best = dist
    Next obj
    Distance = best
End Property


' ***********************************************
' Create normals for polygon objects.
' ***********************************************
Sub CreateNormal()
Dim obj As Object

    For Each obj In Objects
        If obj.ObjectType = "SOLID" Or _
           obj.ObjectType = "POLYGON" Then _
                obj.CreateNormal Objects
    Next obj
End Sub


' ************************************************
' Draw the transformed picture on a Form, Printer,
' or PictureBox. Draw the faces in depth-sort
' order using polygon shading.
' ************************************************
Public Sub DrawShaded(canvas As Object, Optional r As Variant)
Dim ordered As New Collection
Dim obj As Object
Dim besti As Integer
Dim bestz As Single
Dim newz As Single
Dim i As Integer

    ' Compute each object's Zmax value.
    For Each obj In Objects
        If obj.ObjectType = "SOLID" Or _
           obj.ObjectType = "TRANSFORMED" _
            Then obj.SetZmax
    Next obj

    ' Sort the objects by their Zmax values.
    Do While Objects.Count > 0
        ' Find the face with the smallest Zmax
        ' left in the Faces collection.
        besti = 1
        bestz = Objects.Item(1).zmax
        For i = 2 To Objects.Count
            newz = Objects.Item(i).zmax
            If bestz > newz Then
                besti = i
                bestz = newz
            End If
        Next i

        ' Add the best object to the sorted list.
        ordered.Add Objects.Item(besti)
        Objects.Remove besti
    Loop

    ' Replace the Objects collection with the
    ' ordered collection.
    Set Objects = ordered

    ' Draw the objects in sorted order.
    For Each obj In Objects
        obj.DrawShaded canvas, r
    Next obj
End Sub


' ************************************************
' Draw the transformed picture on a Form, Printer,
' or PictureBox. Draw the faces in depth-sort
' order.
' ************************************************
Public Sub DrawOrdered(canvas As Object, Optional r As Variant)
Dim ordered As New Collection
Dim obj As Object
Dim besti As Integer
Dim bestz As Single
Dim newz As Single
Dim i As Integer

    ' Compute each object's Zmax value.
    For Each obj In Objects
        If obj.ObjectType = "SOLID" Or _
           obj.ObjectType = "TRANSFORMED" _
            Then obj.SetZmax
    Next obj

    ' Sort the objects by their Zmax values.
    Do While Objects.Count > 0
        ' Find the face with the smallest Zmax
        ' left in the Faces collection.
        besti = 1
        bestz = Objects.Item(1).zmax
        For i = 2 To Objects.Count
            newz = Objects.Item(i).zmax
            If bestz > newz Then
                besti = i
                bestz = newz
            End If
        Next i

        ' Add the best object to the sorted list.
        ordered.Add Objects.Item(besti)
        Objects.Remove besti
    Loop

    ' Replace the Objects collection with the
    ' ordered collection.
    Set Objects = ordered

    ' Draw the objects in sorted order.
    For Each obj In Objects
        obj.DrawOrdered canvas, r
    Next obj
End Sub


Property Let Culled(value As Boolean)
Dim obj As Object

    For Each obj In Objects
        obj.Culled = value
    Next obj
End Property




' ************************************************
' Find an object that contains this point.
' ************************************************
Function NearestObject(X As Single, Y As Single) As Object
Dim obj As Object

    ' Find the object.
    For Each obj In Objects
        If obj.Contains(X, Y) Then
            Set NearestObject = obj
            Exit Function
        End If
    Next obj
    Set NearestObject = Nothing
End Function


Function ObjectType() As String
    ObjectType = TYPE_STRING
End Function


' ************************************************
' Save the objects in the picture into a metafile.
' ************************************************
Sub MakeWMF(mhdc As Integer)
Dim obj As Object

    For Each obj In Objects
        obj.MakeWMF mhdc
    Next obj
End Sub

' ************************************************
' Read the picture from a file using Input.
' Assume TYPE_STRING has already been read.
' ************************************************
Sub FileInput(filenum As Integer)
Dim num As Integer
Dim i As Integer
Dim obj As Object
Dim obj_type As String

    ' Read the number of objects in the file.
    Input #filenum, num

    ' Repeatedly read objects from the file.
    For i = 1 To num
        Input #filenum, obj_type
        Select Case obj_type
            Case TYPE_STRING
                Set obj = New ObjPicture
            Case "SOLID"
                Set obj = New ObjSolid
            Case Else
                Beep
                MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
                Exit Sub
        End Select
        obj.FileInput filenum
        Objects.Add obj
    Next i
End Sub

' ************************************************
' Draw the picture on a Form, Printer, or
' PictureBox.
' ************************************************
Sub Draw(canvas As Object, Optional r As Variant)
Dim obj As Object

    For Each obj In Objects
        obj.Draw canvas, r
    Next obj
End Sub
Public Sub ClipEye(r As Single)
Dim obj As Object

    For Each obj In Objects
        If obj.ObjectType = "SOLID" Then _
            obj.ClipEye r
    Next obj
End Sub

' ************************************************
' Perform backface removal on the solids.
' ************************************************
Public Sub Cull(X As Single, Y As Single, z As Single)
Dim obj As Object

    For Each obj In Objects
        If obj.ObjectType = "SOLID" Or _
           obj.ObjectType = "TRANSFORMED" _
        Then obj.Cull X, Y, z
    Next obj
End Sub

' ************************************************
' Write the picture to a file using Write.
' Begin with TYPE_STRING to identify this object.
' ************************************************
Sub FileWrite(filenum As Integer)
Dim obj As Object

    Write #filenum, TYPE_STRING
    Write #filenum, Objects.Count

    For Each obj In Objects
        obj.FileWrite filenum
    Next obj
End Sub

' ************************************************
' Apply a nonlinear transformation to the objects.
' ************************************************
Sub Distort(trans As Object)
Dim obj As Object

    For Each obj In Objects
        obj.Distort trans
    Next obj
End Sub


' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' objects.
' ************************************************
Sub ApplyFull(M() As Single)
Dim obj As Object

    For Each obj In Objects
        obj.ApplyFull M
    Next obj
End Sub
' ************************************************
' Apply a transformation matrix to the objects.
' ************************************************
Sub Apply(M() As Single)
Dim obj As Object

    For Each obj In Objects
        obj.Apply M
    Next obj
End Sub